home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / System7 tools / S / System 7 corner / 7.0fostuff / 7.0fo.p < prev    next >
Encoding:
Text File  |  1991-03-25  |  10.0 KB  |  311 lines  |  [TEXT/MPS ]
  1. {7.0fo.p}
  2.  
  3. { A demo of 7.0 process manager calls and outline fonts. }
  4. { © 1991 Harry Chesley. }
  5.  
  6. unit fo;
  7.  
  8. interface
  9.  
  10.     uses
  11.         Quickdraw, Sound, Files, Processes, Packages, Fonts,
  12.         Memory, Toolutils, OSUtils, GestaltEqu, GraphicsModuleTypes;
  13.  
  14.     function DoInitialize (var storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
  15.  
  16.     function DoBlank (storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
  17.  
  18.     function DoDrawFrame (storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
  19.  
  20.     function DoClose (storage: Handle; blankRgn: RgnHandle; params: GMParamBlockPtr): OSErr;
  21.  
  22.     function DoSetup (blankRgn: rgnHandle; message: integer; params: GMParamBlockPtr): OSErr;
  23.  
  24. implementation
  25.  
  26. const
  27.  
  28. kLimitOn100kSz = 600000;                    { Limit on size of processes displayed with outline. }
  29.  
  30. kNoProcessManagerString = 1000;        { No process manager error 'STR '. }
  31. kFontString = 1001;                                { Display font name 'STR '. }
  32.  
  33. type
  34.  
  35. { Our persistent data. }
  36. ourData =
  37.     record
  38.         fontNumber: integer;        { Display font to use. }
  39.         lastUpdate: longInt;            { Time of last update. }
  40.     end;
  41.  
  42. ourPtr = ^ourData;
  43. ourHandle = ^ourPtr;
  44.  
  45. function max3(a,b,c: integer): integer;
  46.     { The max function for three integers. }
  47.  
  48.     begin
  49.         if a > b then
  50.             begin
  51.                 if a > c then max3 := a
  52.                 else max3 := c;
  53.             end
  54.         else
  55.             begin
  56.                 if b > c then max3 := b
  57.                 else max3 := c;
  58.             end;
  59.     end;
  60.  
  61. function DoInitialize (var storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
  62.     { Intialize our globals. }
  63.  
  64.     var od: ourHandle;
  65.         s: Str255;
  66.         i: integer;
  67.         osAttr: longInt;
  68.         sHand: StringHandle;
  69.  
  70.     begin
  71.         { Determine that the Process Manager is available. (Note: just calling Gestalt without first checking
  72.             that it's available only works with MPW 3.2 and later.) }
  73.         if Gestalt(gestaltOSAttr,osAttr) = noErr then
  74.             if BitTst(@osAttr,31-gestaltLaunchControl) then
  75.                 begin
  76.                     { Allocate our storage. }
  77.                     storage := NewHandle(sizeof(ourData));
  78.                     if MemError <> noErr then
  79.                         begin
  80.                             DoInitialize := MemError;
  81.                             exit(DoInitialize);
  82.                         end;
  83.                     od := ourHandle(storage);
  84.             
  85.                     { Get the font to use for displays. }
  86.                     s := GetString(kFontString)^^;
  87.                     GetFNum(s,i);
  88.                     od^^.fontNumber := i;
  89.  
  90.                     { Force immediate update. }
  91.                     od^^.lastUpdate := 0;
  92.  
  93.                     { Get really random numbers. }
  94.                     params^.qdGlobalsCopy^.qdRandSeed := TickCount;
  95.  
  96.                     DoInitialize := noErr;
  97.                     exit(DoInitialize);
  98.                 end;
  99.  
  100.         sHand := GetString(kNoProcessManagerString);
  101.         if sHand <> nil then params^.errorMessage^ := sHand^^
  102.         else params^.errorMessage^ := 'This module requires the Process Manager (System 7.0 and later) to run.';
  103.         DoInitialize := ModuleError;
  104.     end;
  105.  
  106.     function DoBlank (storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
  107.         { Blank the screen the first time. }
  108.  
  109.     begin
  110.         { Dim according to the user's wishes. }
  111.         params^.brightness := (params^.controlValues[0] * 255) div 100;
  112.         { Black it out. }
  113.         FillRgn(blankRgn, params^.qdGlobalsCopy^.qdBlack);
  114.         DoBlank := noErr;
  115.     end;
  116.  
  117.  
  118. function DoDrawFrame (storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
  119.     { Go for it. }
  120.  
  121.     var od: ourHandle;                    { Handle to our data (coerced from storage). }
  122.         monitor: integer;                    { Monitor we're displaying on. }
  123.         r: Rect;                                { Rectangle of the current monitor. }
  124.         descRect: Rect;                    { Rectangle for current process description. }
  125.         i: integer;
  126.         b: boolean;
  127.         maxProcSz: longInt;                { Size of largest process. }
  128.         max100kProcSz: longInt;        { Size of largest process under kLimitOn100kSz. }
  129.         fontSize: integer;                    { Process name font size. }
  130.         subFontSize: integer;            { Process info font size. }
  131.         fontFace: Style;                    { Font style. }
  132.         psn: ProcessSerialNumber;    { Process being processed. }
  133.         frontPSN: ProcessSerialNumber;    { Foreground process. }
  134.         pInfo: ProcessInfoRec;            { Info on current process. }
  135.         fSpec: FSSpec;                        { File spec on current process. }
  136.         launchTime: longInt;                { Launch time of current process. }
  137.         szStr: Str255;                        { Process size description. }
  138.         cpuHrStr, cpuMinStr, cpuSecStr, cpuStr: Str255;    { CPU time strings. }
  139.         launchTimeStr, launchDateStr: Str255;    { Launch date/time strings. }
  140.         s1, s2, s3: Str255;                { Line 1, 2, and 3 of the description. }
  141.         w, h, v: integer;                    { Width and location of the description. }
  142.         mainFontInfo: FontInfo;            { Font info for process name line. }
  143.         subFontInfo: FontInfo;            { Font info for process description lines. }
  144.         ignore: OSErr;
  145.  
  146.     begin
  147.         { Dim as requested. }
  148.         params^.brightness := (params^.controlValues[0] * 255) div 100;
  149.  
  150.         { Get our data. }
  151.         od := OurHandle(storage);
  152.         if od = nil then exit(DoDrawFrame);
  153.  
  154.         { Check if it's time to update display yet. }
  155.         if TickCount < (od^^.lastUpdate + params^.controlValues[1] * 60) then exit(DoDrawFrame);
  156.         od^^.lastUpdate := TickCount;
  157.  
  158.         { Set up process info structure. }
  159.         pInfo.processInfoLength := sizeof(pInfo);
  160.         pInfo.processName := @s1;
  161.         pInfo.processAppSpec := @fSpec;
  162.  
  163.         { Get the largest sized processes. }
  164.         maxProcSz := 0;
  165.         max100kProcSz := 0;
  166.         psn.highLongOfPSN := 0;
  167.         psn.lowLongOfPSN := kNoProcess;
  168.         while GetNextProcess(psn) = noErr do
  169.             if GetProcessInformation(psn,pInfo) = noErr then
  170.                 begin
  171.                     if pInfo.processSize > maxProcSz then maxProcSz := pInfo.processSize;
  172.                     if (pInfo.processSize < kLimitOn100kSz) and (pInfo.processSize > max100kProcSz) then
  173.                         max100kProcSz := pInfo.processSize;
  174.                 end;
  175.  
  176.         { Get foreground process. }
  177.         ignore := GetFrontProcess(frontPSN);
  178.  
  179.         { Set up pen for drawing. }
  180.         PenNormal;
  181.         backColor(whiteColor);
  182.         foreColor(blackColor);
  183.         { Blank screen. }
  184.         FillRgn(blankRgn, params^.qdGlobalsCopy^.qdBlack);
  185.         { Draw white/black or black/white. }
  186.         if params^.controlValues[2] = 0 then
  187.             begin
  188.                 backColor(blackColor);
  189.                 foreColor(whiteColor);
  190.             end;
  191.         { Select the font. }
  192.         TextFont(od^^.fontNumber);
  193.  
  194.         { For each monitor... }
  195.         for monitor := 0 to params^.monitors^.monitorCount-1 do
  196.             begin
  197.                 r := params^.monitors^.monitorList[monitor].bounds;
  198.  
  199.                 { For each process... }
  200.                 psn.highLongOfPSN := 0;
  201.                 psn.lowLongOfPSN := kNoProcess;
  202.                 while GetNextProcess(psn) = noErr do
  203.                     begin
  204.                         { Try to get the process's info. }
  205.                         if GetProcessInformation(psn,pInfo) <> noErr then
  206.                             begin
  207.                                 { If things failed, display at error code. }
  208.                                 fontSize := 24;
  209.                                 subFontSize := 12;
  210.                                 fontFace := [];
  211.                                 s1 := 'GetProcessInformation Error';
  212.                                 NumToString(GetProcessInformation(psn,pInfo),s2);
  213.                                 s3 := '';
  214.                             end
  215.                         else
  216.                             begin
  217.                                 { Compute the font size and style. }
  218.                                 if pInfo.processSize < kLimitOn100kSz then
  219.                                     begin
  220.                                         fontFace := [];
  221.                                         fontSize := (((r.bottom - r.top) div 10) * pInfo.processSize) div max100kProcSz;
  222.                                     end
  223.                                 else
  224.                                     begin
  225.                                         fontFace := [bold];
  226.                                         fontSize := (((r.bottom - r.top) div 10) * pInfo.processSize) div maxProcSz;
  227.                                     end;
  228.                                 if fontSize < 12 then fontSize := 12;
  229.                                 subFontSize := fontSize div 2;
  230.                                 if subFontSize < 10 then subFontSize := 10;
  231.                                 if SameProcess(psn,frontPSN,b) = noErr then
  232.                                     if b then fontFace := fontFace + [italic];
  233.  
  234.                                 { Create the description to display. }
  235.                                 NumToString(pInfo.processSize div 1024,szStr);
  236.                                 pInfo.processActiveTime := pInfo.processActiveTime div 60;
  237.                                 NumToString(pInfo.processActiveTime div 3600,cpuHrStr);
  238.                                 if length(cpuHrStr) = 1 then cpuHrStr := Concat('0',cpuHrStr);
  239.                                 NumToString((pInfo.processActiveTime div 60) mod 60,cpuMinStr);
  240.                                 if length(cpuMinStr) = 1 then cpuMinStr := Concat('0',cpuMinStr);
  241.                                 NumToString(pInfo.processActiveTime mod 60,cpuSecStr);
  242.                                 if length(cpuSecStr) = 1 then cpuSecStr := Concat('0',cpuSecStr);
  243.                                 GetDateTime(launchTime);
  244.                                 launchTime := launchTime - (TickCount - pInfo.processLaunchDate) div 60;
  245.                                 IUTimeString(launchTime,false,launchTimeStr);
  246.                                 IUDateString(launchTime,abbrevDate,launchDateStr);
  247.                                 s2 := Concat('Launched: ',launchTimeStr,' on ',launchDateStr);
  248.                                 s3 := Concat('Size: ',szStr,'k; CPU time: ',cpuHrStr,':',cpuMinStr,':',cpuSecStr);
  249.                             end;
  250.         
  251.                         { Pick a random location for the text that's certain to show. }
  252.                         if fontSize = 12 then fontFace := fontFace - [outline];
  253.                         TextFace(fontFace);
  254.                         TextSize(fontSize);
  255.                         { Note: srcCopy in text mode is not recommended (according to Inside Mac I), but it works for us here. }
  256.                         TextMode(srcCopy);
  257.                         GetFontInfo(mainFontInfo);
  258.                         w := StringWidth(s1);
  259.                         TextSize(subFontSize);
  260.                         GetFontInfo(subFontInfo);
  261.                         w := max3(w,StringWidth(s2),StringWidth(s3));
  262.                         h := r.right - r.left - w - 20;
  263.                         if h <= 0 then h := 1;
  264.                         h := r.left + 10 + abs(Random mod h);
  265.                         v := r.top + 10 + mainFontInfo.ascent;
  266.                         v := v + abs(Random mod (r.bottom - r.top - 20 - mainFontInfo.ascent - mainFontInfo.descent -
  267.                             2 * (subFontInfo.leading + subFontInfo.ascent + subFontInfo.descent)));
  268.                         descRect.top := v-mainFontInfo.ascent-10;
  269.                         descRect.left := h-10;
  270.                         descRect.bottom := v+mainFontInfo.descent +
  271.                             2 * (subFontInfo.leading+subFontInfo.ascent+subFontInfo.descent) + 10;
  272.                         descRect.right := h + w + 10;
  273.  
  274.                         { Draw the box. }
  275.                         FillRoundRect(descRect, 20, 20, params^.qdGlobalsCopy^.qdWhite);
  276.                         FrameRoundRect(descRect, 20, 20);
  277.                 
  278.                         { Draw the process name. }
  279.                         TextSize(fontSize);
  280.                         MoveTo(h,v);
  281.                         DrawString(s1);
  282.                 
  283.                         { Draw the process info. }
  284.                         TextSize(subFontSize);
  285.                         MoveTo(h,v+mainFontInfo.descent+subFontInfo.leading+subFontInfo.ascent);
  286.                         DrawString(s2);
  287.                         MoveTo(h,v+mainFontInfo.descent+subFontInfo.descent+ 2 * (subFontInfo.leading+subFontInfo.ascent));
  288.                         DrawString(s3);
  289.                     end;
  290.             end;
  291.  
  292.         DoDrawFrame := noErr;
  293.  
  294.     end;
  295.  
  296. function DoClose (storage: Handle; blankRgn: RgnHandle; params: GMParamBlockPtr): OSErr;
  297.     { Free our persistent data. }
  298.  
  299.     begin
  300.         if storage <> nil then DisposHandle(storage);
  301.         DoClose := noErr;
  302.     end;
  303.  
  304. function DoSetup (blankRgn: rgnHandle; message: integer; params: GMParamBlockPtr): OSErr;
  305.     {This is called when the used clicks on a button in the Control Panel.}
  306.  
  307.     begin
  308.         DoSetup := noErr;
  309.     end;
  310.  
  311. end.